home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Snippets / vListMngr 1.0 / Sources ƒ / DemoList_Procs < prev    next >
Encoding:
Text File  |  1996-04-10  |  3.3 KB  |  123 lines  |  [TEXT/PJMM]
  1. unit DemoList_Procs;
  2.  
  3. interface
  4.  
  5.     uses
  6.         vListMngr, vListDemo_Globals, DemoList_Window;
  7.  
  8.     procedure NewDemoList;
  9.     procedure CloseDemoList;
  10.     procedure ShowHeadings;
  11.     procedure ClearHeadings;
  12.     procedure RefreshList;
  13.  
  14.  
  15. implementation
  16.  
  17.     const
  18.         cellHeight = 0;        {# pixels per cell}
  19.         nCols = 12;                {# cells to start with}
  20.         nhRows = 2;
  21.  
  22.  
  23.     procedure RefreshList;
  24. {restore original cell widths and values}
  25.         var
  26.             i, j: INTEGER;
  27.             tStr: STR255;
  28.             theCell: Cell;
  29.             tWidths: widthArray;
  30.     begin
  31.         if DemoList <> nil then
  32.             begin
  33.                 vLActivate(FALSE, DemoList);                {don't draw till all cells are set}
  34.                 for i := 0 to nCols - 1 do
  35.                     for j := 0 to nCols - 1 do
  36.                         begin
  37.                             tStr := Concat(StringOf(i : 2), ',', StringOf(j : 2));
  38.                             theCell.h := i;
  39.                             theCell.v := j;
  40.                             vLSetCell(Ptr(ORD4(@tStr) + 1), Length(tStr), theCell, DemoList);
  41.                         end;
  42.                 for i := 0 to maxCols do
  43.                     tWidths[i] := DemoList^^.cellSize.h;
  44.                 vLActivate(TRUE, DemoList);                {redraw list now}
  45.                 vLSetWidths(tWidths, DemoList);
  46.             end;        {DemoList <> nil}
  47.     end;        { procedure RefreshList}
  48.  
  49.     procedure NewDemoList;
  50.         var
  51.             lView, dBounds: RECT;
  52.             tWidths: widthArray;
  53.             i, j, k, tableWidth: INTEGER;
  54.             theCell, cellSize: Point;
  55.             tStr: STR255;
  56.             tRect, teRect: RECT;
  57.             MyPeek: WindowPeek;
  58.  
  59.     begin
  60.         Open_DemoList_Window;
  61.         MyPeek := WindowPeek(DemoListWindow);
  62. {    DemoListWindow := FrontWindow;    {}
  63. {    SetWTitle(DemoListWindow, 'Untitled');        {}
  64.         SetRect(lView, 5, 5, DemoListWindow^.portRect.right - 31, DemoListWindow^.portRect.bottom - 31);    {}
  65.         SetRect(dBounds, 0, 0, nCols, nCols);            {nCols cols to start}
  66.         SetPt(cellSize, 0, 0);
  67.         DemoList := vLNew(lView, dBounds, cellSize, 0, DemoListWindow, FALSE, TRUE, TRUE, TRUE);    {v 9}
  68. {    DemoList := vLNew(lView, dBounds, cellSize, 0, DemoListWindow, FALSE, TRUE, FALSE, FALSE);    {No Scroll bars}
  69.         TheListScrap := vLNewScrap;
  70.         RefreshList;
  71.         SetPt(theCell, 0, 0);
  72.         vLIndent(theCell, DemoList);
  73.         SetPt(theCell, 0, 0);
  74.         DemoList^^.lastClick := theCell;                        {emulate click in theCell}
  75.         vLTENew(FALSE, theCell, DemoList);                {set up a TE record for list}
  76.         vLActivateTE(FALSE, DemoList);                    {start with TE inactive}
  77.         activeTE := DemoList^^.listTE;                        {so we can flash cursor}
  78.         vLActivate(TRUE, DemoList);                        {show the list}
  79.     end;        { procedure NewDemoList}
  80.  
  81.  
  82.     procedure ShowHeadings;
  83.         const
  84.             TTHead1 = 'Time  |   Feed   |  Collect | Electro |        2Power      |           5Valves              |';                    {}
  85.             TTHead2 = ' min   | uL/min | uL/min  | on/off  | Volts | mAmps | A |  B |  C |  D |  E |       Notes       |';        {}
  86.             nhRow = 2;
  87.         var
  88.             lHeadings: lHeadArray;
  89.             tWidths: widthArray;
  90.             nCols: INTEGER;
  91.     begin
  92.         lHeadings[1] := TTHead1;
  93.         lHeadings[2] := TTHead2;
  94.         vLSetHeadings(nhRow, lHeadings, DemoList);
  95.         vLCalcCellWidths(tWidths, nCols, DemoList);    {}
  96.         vLSetWidths(tWidths, DemoList);                {}
  97.         activeTE := DemoList^^.listTE;                    {so we can flash cursor}
  98.     end;        {procedure ShowHeadings}
  99.  
  100.     procedure ClearHeadings;
  101.         var
  102.             lHeadings: lHeadArray;
  103.     begin
  104.         vLSetHeadings(0, lHeadings, DemoList);
  105.         RefreshList;
  106.     end;        {procedure ClearHeadings}
  107.  
  108.     procedure CloseDemoList;
  109.     begin
  110.         if DemoList <> nil then
  111.             begin
  112.                 vLDispose(DemoList);
  113.                 DemoList := nil;
  114.                 if TheListScrap <> nil then
  115.                     begin
  116.                         DisposHandle(Handle(TheListScrap));
  117.                         TheListScrap := nil;
  118.                     end;
  119.             end;        {if..}
  120.     end;        {}
  121.  
  122.  
  123. end.        {unit DemoList}